R/EQ5D Scoring Algorithm.R

In mccartqm/proms: Score Patient-Reported Outcome Measures

#' Calculates the U.S. preference-weighted EQ-5D-3L index score.
#' 
#' @param data A data frame.
#' @param varnames A character vector specifying the variable names of the five
#'    questions used to compute the EQ5D index score
#'    
#' @return This function returns the original data frame provided as input with 
#'    an additional variable storing the EQ5D index score.
#' 
#' @export

eq5d <- function(data, varnames) {
  
  # coerce arguments to be of numeric type
  # if(!is.numeric(data$MO)) {as.character(data$MO)}
  # ck <- function(cols, data){
  #   sapply(names[data[, varnames], function(x) !is.numeric(x)], as.numeric)
  # }
  
  # GENERATE DUMMY VARIABLES
  for (i in varnames){
    
    # replace undefined values with missing values
    # equivalent to "df.test[[i]][!is.na(df.test[[i]]) & !(df.test[[i]] %in% c(1,2,3))] <- NA" by DeMorgan laws
    data[[i]][!(is.na(data[[i]]) | data[[i]] %in% c(1,2,3))] <- NA
    
    # generate dummy variables only as needed (e.g. if level=3 not selected for any observation, then dummy var not created)
    for (level in 1:3){
      data[paste0(i, level)] <- ifelse(data[[i]]==level, 1, 0)
    }
  }
  
  # generate d1 term
  data$i1 = 4 - rowSums(data[names(data)[seq(ncol(data)-14, ncol(data)-2, 3)]])
  data$i1[data$i1 < 0] <- 0
  
  # generate interaction terms (i2, i2.squared, i3, i3.squared)
  data$i2 <- rowSums(data[names(data)[seq(ncol(data)-14, ncol(data)-2, 3)]]) - 1
  data$i2[data$i2 < 0] <- 0
  
  data$i3 <- rowSums(data[names(data)[seq(ncol(data)-14, ncol(data)-2, 3)]]) - 1
  data$i3[data$i3 < 0] <- 0
  
  data$i22 <- data$i2*data$i2
  
  data$i32 <- data$i3*data$i3
  
  # generate raw index score
  data$EQ5Dindex <- 1 - (.146016*data[[ncol(data)-18]] + .557685*data[[ncol(data)-17]] + 
    .1753425*data[[ncol(data)-15]] + .4711896*data[[ncol(data)-14]] + 
    .1397295*data[[ncol(data)-12]] + .3742594*data[[ncol(data)-11]] + 
    .1728907*data[[ncol(data)-9]] + .5371011*data[[ncol(data)-8]] + 
    .156223*data[[ncol(data)-6]] + .4501876*data[[ncol(data)-5]] - 
    .1395949*data[[ncol(data)-4]] + 
    .0106868*data[[ncol(data)-1]] - .1215579*data[[ncol(data)-2]] - .0147963*data[[ncol(data)]])
  
  # drop variables generated by program
  data[, -c((ncol(data)-20):(ncol(data)-1))]
  
}